
'----------------------------------------------------------------
' Examples in the "COntrolling the Page Setup" Section
' Statements to be entered in the Immediate Window
'----------------------------------------------------------------

Application.Dialogs(xlDialogPageSetup).Show
Application.Dialogs(xlDialogPageSetup).Show Arg11:=2
Application.Dialogs(xlDialogPageSetup).Show Arg9:=1, Arg11:=1
ActiveSheet.PageSetup.Orientation = 2 : Application.Dialogs(xlDialogPageSetup).Show


'----------------------------------------------------------------
' Example procedure following Table 22-2
'----------------------------------------------------------------

Sub ShowWaterMark()
  With Worksheets("Sheet1").PageSetup.CenterHeaderPicture
    .Filename = "C:\Ex07_HandsOn\cd.bmp"
    .Height = 75
    .Width = 75
    .Brightness = 0.25
    .ColorType = msoPictureWatermark
    .Contrast = 0.45
  End With

' Display the picture in the center header.
Worksheets("Sheet1").PageSetup.CenterHeader = "&G"
End Sub


'----------------------------------------------------------------
' Hands-On 22-1
'----------------------------------------------------------------

Sub ShowPageSettings()
    With ActiveSheet.PageSetup
        Debug.Print "Orientation="; .Orientation
        Debug.Print "Paper Size = "; .PaperSize
        Debug.Print "Print Gridlines = "; .PrintGridlines
        Debug.Print "Horizontal Print Quality = "; .PrintQuality(1)
        Debug.Print "Print Area = "; .PrintArea
    End With
End Sub


Sub ShowPageSettings2()
    With ActiveSheet.PageSetup
        Debug.Print "Orientation="; .Orientation
        Debug.Print "Paper Size = "; .PaperSize
        Debug.Print "Print Gridlines = "; .PrintGridlines
        Debug.Print "Horizontal Print Quality = "; .PrintQuality(1)
        Cells(1, 1).Select
          .PrintArea = ActiveCell.CurrentRegion.Address
        Debug.Print "Print Area = "; .PrintArea;
        .CenterHorizontally = True
        .CenterVertically = True
        .CenterHeader = "Bonus Information Sheet"
    End With
    Application.Dialogs(xlDialogPrintPreview).Show
End Sub


Sub FormatSheet()
    Dim curReg As Range
    Set curReg = ActiveCell.CurrentRegion

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        Cells(1, 1).Select

        .PrintArea = curReg.Offset(1, 0). _
            Resize(curReg.Rows.Count - 1, _
            curReg.Columns.Count).Address

        Debug.Print "Print Area = "; .PrintArea;
        .CenterHeader = "Bonus Information Sheet"
        .CenterHorizontally = False
        .CenterVertically = False
        .PrintGridlines = True
    End With
    Application.Dialogs(xlDialogPrintPreview).Show
End Sub


'--------------------------------------------------------------------------
'Statements to be entered in the Immediate Window
'--------------------------------------------------------------------------

ActiveWindow.View =xlPageLayoutView
Application.Dialogs(xlDialogPrintPreview).Show
Worksheets("Sheet1").PrintPreview
Application.Dialogs(xlDialogPrintPreview).Show False
Worksheets("Sheet1").PrintPreview enableChanges:=False
Worksheets("Sheet1").PrintPreview False

Application.Dialogs(xlDialogPrinterSetup).Show
MsgBox Application.ActivePrinter


'----------------------------------------------------------------
' Hands-On 22-2
'----------------------------------------------------------------

Sub Auto_Open()
    Application.ActivePrinter = "Lexmark Optra M412 (MS) on Ne05:"
    MsgBox Application.ActivePrinter
End Sub


'--------------------------------------------------------------------------
'Statements to be entered in the Immediate Window
'--------------------------------------------------------------------------

Application.Dialogs(xlDialogPrint).Show
Application.Dialogs(xlDialogPrint).Show Arg1:=2, Arg2:=1, Arg3:=2
ActiveSheet.PrintOut


'--------------------------------------------------------------------------
'Event Procedure in the ThisWorkbook Code Module
'--------------------------------------------------------------------------


Private Sub Workbook_BeforePrint(Cancel As Boolean)
  If Worksheets("Sheet1").Range("A1") <> "Monthly Report" Then
    MsgBox "Please enter correct data in cell A1."
    Cancel = True
  End If
End Sub


'--------------------------------------------------------------------------
' Hands-On 22-3
'--------------------------------------------------------------------------

Public WithEvents objApp As Application

Private Sub objApp_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    With Wb.ActiveSheet
        .PageSetup.RightFooter = Wb.FullName
    End With
End Sub

-----------------------------------------------------------------------------

Dim clsFullPath As New clsFooter

Private Sub Workbook_Open()
    Set clsFullPath.objApp = Application
End Sub

-----------------------------------------------------------------------------


Sub Discover_EmailSystem()
    Select Case Application.MailSystem
        Case xlMAPI
            MsgBox "You have Microsoft Mail installed."
        Case xlNoMailSystem
            MsgBox "No mail system installed on this computer."
        Case xlPowerTalk
            MsgBox "Your mail system is PowerTalk"
    End Select
End Sub


'--------------------------------------------------------------------------
' Hands-On 22-4
'--------------------------------------------------------------------------

Sub SendMailNow()
    Dim strEAddress As String

    On Error GoTo ErrorHandler

    strEAddress = InputBox("Enter e-mail address", _
                "Recipient's E-mail Address ")

    If IsNull(Application.MailSession) Then
        Application.MailLogon
    End If

    ActiveWorkbook.SendMail Recipients:=strEAddress, Subject:="Test Mail"

    Application.MailLogoff
    Exit Sub

ErrorHandler:
    MsgBox "Some error occurred while sending e-mail."
End Sub


'--------------------------------------------------------------------------
' Hands-On 22-5
'--------------------------------------------------------------------------

Sub SendMsoMail(ByVal strRecipient As String)
    Dim objMailItem As MailItem

    ' use MailEnvelope property of the Worksheet to return the
    ' msoEnvelope object
    With ActiveSheet.MailEnvelope

    ' Add introductory text at the top of the e-mail
     .Introduction = "Please see the list of employees " & _
                    "who are to receive a bonus."

       ' Set up a reference to the MailItem to access
       ' Outlook MailItem properties and methods
            Set objMailItem = .Item
            ' Set up the Mailtem
            With objMailItem
                ' Make sure the e-mail format is HTML
                .BodyFormat = olFormatHTML
                ' Add the recipient name
                .Recipients.Add strRecipient
                ' Add the subject
                .Subject = "Employee Bonuses"
                ' Send Mail
                .Send
            End With
    End With
End Sub


'--------------------------------------------------------------------------
' Hands-On 22-6
'--------------------------------------------------------------------------

Sub SendBulkMail(EmailCol, BeginRow, EndRow, SubjCol, AmountCol)
    Dim objOut As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim strEmail As String
    Dim strSubject As String
    Dim strBody As String
    Dim r As Integer

    On Error Resume Next

    Application.DisplayAlerts = False

    Set objOut = New Outlook.Application

    For r = BeginRow To EndRow
        Set objMail = objOut.CreateItem(olMailItem)
        strEmail = Cells(r, EmailCol)
        strSubject = Cells(r, SubjCol) & " reimbursement"

        strBody = "We have approved your request for " & _
                   LCase(strSubject)
        strBody = strBody & " in the amount of " & Cells(r, _
                   AmountCol).Text & "."
        strBody = strBody & vbCrLf & "Please allow 3 business " & _
                    "days for this"
        strBody = strBody & " amount to appear on your bank statement."
        strBody = strBody & vbCrLf & vbCrLf & " Employee Services"

        With objMail
            .To = strEmail
            .Body = strBody
            .Subject = strSubject
            .Send
        End With
    Next
    Set objOut = Nothing
    Application.DisplayAlerts = True
End Sub


Sub Call_SendBulkMail()

     SendBulkMail EmailCol:=4, _
          BeginRow:=2, _
          EndRow:=5, _
          SubjCol:=2, _
          AmountCol:=3
End Sub




